The Utilities Experience

home *** CD-ROM | disk | FTP | other *** search

/ The Utilities Experience / The Utilities Experience - Volume 1.iso / software / icons+tools / iconian / sources / doloaddt.e < prev next >

Wrap

Text File | 1995-12-22 | 57KB | 1,844 lines

/* DoLoadDT.m -- A datatype load, scale, remap and dither routine. */ /* $VER:doloaddt 0.88 (7.6.95) */ /* THIS SOURCE IS COPYRIGHT 1994,1995 by Chad Randall, mbissaymssiK Software If you wish to include this, or any modified version of this routine in your own program, you *MUST* credit me somewhere in your program and/or documentation. I am distributing this source mainly for those who wish to learn a thing or two. Please don't rip me off. */ OPT MODULE OPT PREPROCESS MODULE 'exec/memory','exec/types' MODULE 'dos/dos' MODULE 'intuition/intuition','intuition/screens','intuition/gadgetclass','intuition/imageclass' MODULE 'graphics/rastport','graphics/gfx','graphics/text','graphics/scale','graphics/view', 'graphics/gfxbase','graphics/clip','graphics/layers','graphics/modeid' MODULE 'iffparse','libraries/iffparse' MODULE 'utility','utility/hooks','utility/tagitem' MODULE 'datatypes','datatypes/datatypes','datatypes/datatypesclass','datatypes/pictureclass' MODULE 'mathffp' MODULE 'gadtools','libraries/gadtools' MODULE 'tools/boopsi' MODULE 'mod/fonts' MODULE 'mod/bits' MODULE 'mod/compare' MODULE 'mod/gadgets' MODULE 'mod/macros' MODULE 'mod/pool' MODULE 'mod/color' MODULE 'mod/tags' MODULE 'gaugeimage','class/gaugeimage' EXPORT OBJECT sizestruct font:LONG x:INT y:INT type:CHAR ENDOBJECT EXPORT OBJECT statwindow scr:PTR TO screen centerx:INT centery:INT textfont:PTR TO textfont textattr:PTR TO textattr textstyle:LONG load_string:LONG scale_string:LONG histogram_string:LONG quant_string:LONG render_string:LONG cancel_string:LONG title_string:LONG status_string:LONG ENDOBJECT EXPORT OBJECT imageinfo source_w:LONG source_h:LONG destination_x:LONG destination_y:LONG destination_w:LONG destination_h:LONG depth:LONG highest_pen:LONG statwindowx:LONG statwindowy:LONG reserved3:LONG reserved4:LONG reserved5:LONG reserved6:LONG reserved7:LONG reserved8:LONG blackpen:LONG whitepen:LONG greypen:LONG ENDOBJECT EXPORT ENUM DLDT_CENTER=TAG_USER, ->Centers image in w/h DLDT_INTEGERSCALE, ->OBSOLETE DLDT_DITHER, -> DLDT_REMAP, ->Use FindColor to remap pens? DLDT_ASPECTX, ->x aspect value as in x:y DLDT_ASPECTY, ->y aspect value DLDT_SCALE, ->Should we scale, or crop? if=false then crop. DLDT_USEASPECT, ->Should we use the aspect values, or do 1:1 to 1:1? DLDT_ENLARGE, ->OBSOLETE DLDT_CLEAR, ->Clears from x->y, w->h DLDT_GAUGE, ->OBSOLETE DLDT_CLIGAUGE, ->A ptr to a STRING with an imbedded "%s" code. DLDT_HOOK, ->OBSOLETE DLDT_INFO, ->A ptr to a imageinfo struct to be filled in. DLDT_BIDIRECTIONAL, ->OBSOLETE DLDT_DIARRAY, ->OBSOLETE DLDT_HIGHPEN, ->Highest pen to use, -1 for all available. (default) DLDT_FILLCMAP, -> Use DT cmap, and fill-in given cmap! no faint-hearts!!! DLDT_GREYSCALE, -> create greyscale icon DLDT_QUANTIZE, -> quantize to x number of colors DLDT_CUSTOMFINDCOLOR, -> OBSOLETE DLDT_RENDERHAM, -> if =6 then HAM6, if =8 then HAM8, else normal DLDT_HAMTHRESHOLD, -> specifies when to use base-4 colors DLDT_FULLHAMBASE, DLDT_DISCARDERROR, DLDT_STRETCHTOFIT, DLDT_NORENDER, DLDT_STATWINDOW, DLDT_ACTIVATESTATWINDOW, DLDT_DITHERTYPE, DLDT_QUANTTYPE, DLDT_SHOWSIZE EXPORT ENUM DITH_ERRORDIFF,DITH_FLOYD,DITH_STUCKI,DITH_BURKES EXPORT ENUM QUANT_VERBATIM,QUANT_POPULARITY,QUANT_MEDIANCUT,QUANT_MEDIANCUT2,QUANT_MEDIANCUT3,QUANT_MEDIANCUT4,QUANT_MEDIANCUT5,QUANT_MEDIANCUT6,QUANT_MEDIANCUT7,QUANT_END EXPORT ENUM TEXT_NORMAL,TEXT_SHADOW,TEXT_OUTLINE DEF dtlib,utillib,ifflib,mathlib #define PPM_GETR(p) (Shr(Shr(((p) AND $FF0000),8),8)) #define PPM_GETG(p) (Shr(((p) AND $FF00),8)) #define PPM_GETB(p) ((p) AND $FF) #define PPM_PUTR(red) (Shl(Shl(((red) AND $FF),8),8)) #define PPM_PUTG(grn) (Shl(((grn) AND $FF),8)) #define PPM_PUTB(blu) ((blu) AND $FF) #define PPM_ASSIGN(red,grn,blu) ((Shl(Shl(red AND $FF,8),8)) OR (Shl(grn AND $FF,8)) OR (blu AND $FF)) OBJECT box ind:LONG -> Where the box starts in the histogram colors:LONG -> The number of entries involved (colorcount) sum:LONG -> The number of pixels involved redw:INT -> The red width (not scaled) ^3 (volume) grnw:INT -> The green width (not scaled) bluw:INT -> The blue width (not scaled) red0:INT grn0:INT blu0:INT red1:INT grn1:INT blu1:INT ENDOBJECT CONST HASH_SIZE=20023 CONST MAXCOLORS=32767 #define HASHPIXEL(p) (Mod(((p) AND $ffffff),HASH_SIZE)) OBJECT colorhist_item color:LONG value:LONG ENDOBJECT OBJECT colorhist_list_item ch:colorhist_item next:PTR TO colorhist_list_item ENDOBJECT DEF statwindow:PTR TO window DEF gaugeobj DEF stat:PTR TO statwindow DEF histopool DEF drawinfo:PTR TO drawinfo EXPORT PROC doloaddt(source,rast:PTR TO rastport,cmap:PTR TO colormap,x,y,w,h,taglist) HANDLE DEF dtf=NIL:PTR TO dtframebox,fri=NIL:PTR TO frameinfo,obj=NIL:PTR TO datatypeheader,gpl=NIL:PTR TO gplayout DEF dtrast=NIL:PTR TO rastport DEF red[260]:LIST,grn[260]:LIST,blu[260]:LIST DEF cregs,bm=NIL:PTR TO bitmap,bmhd=NIL:PTR TO bitmapheader,modeid DEF norender=FALSE DEF center,intscale=FALSE,dither=TRUE,remap=TRUE,aspectx=1,aspecty=1,scale=TRUE,useaspect=TRUE,enlarge=FALSE,clear=TRUE DEF scalex,scaley,scalef DEF res,res2 DEF trast=NIL:PTR TO rastport,tbm=NIL:PTR TO bitmap DEF sfixx,sfixy DEF ditz=0:PTR TO CHAR,dang=0:PTR TO CHAR,dumb=0:PTR TO CHAR,body:PTR TO CHAR DEF usehighpen=-1 DEF fillcmap=FALSE DEF cm DEF hammode=FALSE,gaugestr=FALSE DEF i,t,u,v,z,xpixper=1,ypixper=1,step,stop DEF scalarx,scalary,percent,adjustw,adjusth,finalw,finalh,finalx,finaly DEF linebuf=0:PTR TO CHAR,redbuf=0,grnbuf=0,blubuf=0 DEF dithermode=DITH_FLOYD DEF showsize=0 DEF stretch=FALSE DEF statx=0,staty=0,statw=0,stath=0 DEF statgad=0 DEF glist=0,gad DEF tmp1=0:PTR TO CHAR,tmp2=0:PTR TO CHAR,tmp3=0:PTR TO CHAR DEF tmp4=0:PTR TO LONG,tmp5,tmp6,tmp7,tmp8,ttmp1,ttmp2,ttmp3 DEF longptr:PTR TO LONG DEF lmp4,lmp5,lmp6 DEF er1,er2,er3,er4 DEF eg1,eg2,eg3,eg4 DEF eb1,eb2,eb3,eb4 DEF sumred=0,sumgrn=0,sumblu=0,num=0 DEF fc,reddif,grndif,bludif,grabbuf=0:PTR TO CHAR DEF realred[260]:LIST,realgrn[260]:LIST,realblu[260]:LIST DEF vis=0 DEF iinfo=0:PTR TO imageinfo DEF highpen=0 DEF activatewindow=FALSE DEF speed1,speed6,speed7,speed8 DEF red24=0,grn24=0,blu24=0 DEF grey=0,quant=256 DEF hamr,hamg,hamb DEF hadr,hadg,hadb DEF renderham=0,hamthres=64 DEF hambase=3 DEF discard=FALSE DEF quantmode=QUANT_MEDIANCUT DEF histo:PTR TO LONG DEF gaugeclass=0 histo:=0;statwindow:=0;stat:=0 dtf:=New(600);fri:=New(600);gpl:=New(600) dtrast:=New(SIZEOF rastport);InitRastPort(dtrast) trast:=New(SIZEOF rastport);CopyMem(dtrast,trast,SIZEOF rastport);trast.layer:=0 IF checklibs()=FALSE THEN Raise("LIB") IF taglist center:=findtag(taglist,DLDT_CENTER) intscale:=findtag(taglist,DLDT_INTEGERSCALE) dither:=findtag(taglist,DLDT_DITHER,TRUE) remap:=findtag(taglist,DLDT_REMAP,TRUE) aspecty:=findtag(taglist,DLDT_ASPECTX,1) aspectx:=findtag(taglist,DLDT_ASPECTY,1) scale:=findtag(taglist,DLDT_SCALE,TRUE) useaspect:=findtag(taglist,DLDT_USEASPECT,TRUE) enlarge:=findtag(taglist,DLDT_ENLARGE) clear:=findtag(taglist,DLDT_CLEAR,TRUE) gaugestr:=findtag(taglist,DLDT_CLIGAUGE) iinfo:=findtag(taglist,DLDT_INFO) usehighpen:=findtag(taglist,DLDT_HIGHPEN,-1) fillcmap:=findtag(taglist,DLDT_FILLCMAP) quant:=limit(findtag(taglist,DLDT_QUANTIZE,256),1,256) grey:=limit(findtag(taglist,DLDT_GREYSCALE),0,2) renderham:=limit(findtag(taglist,DLDT_RENDERHAM),0,8) hamthres:=limit(findtag(taglist,DLDT_HAMTHRESHOLD,64),0,760) speed8:=findtag(taglist,DLDT_FULLHAMBASE) IF speed8 IF renderham=6 hambase:=15 ELSE hambase:=63 ENDIF ENDIF discard:=findtag(taglist,DLDT_DISCARDERROR,discard) stretch:=findtag(taglist,DLDT_STRETCHTOFIT,stretch) norender:=findtag(taglist,DLDT_NORENDER,norender) stat:=findtag(taglist,DLDT_STATWINDOW,stat) activatewindow:=findtag(taglist,DLDT_ACTIVATESTATWINDOW,activatewindow) dithermode:=findtag(taglist,DLDT_DITHERTYPE,dithermode) quantmode:=findtag(taglist,DLDT_QUANTTYPE,quantmode) showsize:=findtag(taglist,DLDT_SHOWSIZE) IF usehighpen=-1 THEN usehighpen:=256 IF (quant<256) usehighpen:=limit(smaller(usehighpen,quant-1),1,255) ENDIF ENDIF IF stat drawinfo:=GetScreenDrawInfo(stat.scr) vis:=GetVisualInfoA(stat.scr, NIL) ENDIF IF ((stat<>0) AND (drawinfo<>0) AND (vis<>0)) statw,stath:=biggest(rast,[stat.load_string,stat.scale_string,stat.histogram_string,stat.render_string,TAG_END]:LONG,stat.textfont,stat.textstyle) tmp1,tmp2:=fontsize2(rast,stat.cancel_string,stat.textfont,stat.textstyle) tmp8,tmp7:=fontsize2(rast,stat.status_string,stat.textfont,stat.textstyle) statw:=bigger(bigger(statw,tmp1),tmp8) tmp8:=bigger(tmp8,statw) statx:=stat.centerx-(statw/2) staty:=stat.centery-(stath/2) tmp3:=(WFLG_SMART_REFRESH OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET) IF activatewindow THEN tmp3:=tmp3 OR WFLG_ACTIVATE statwindow:=OpenWindowTagList(0, [WA_INNERWIDTH,statw+16, WA_INNERHEIGHT,stath+14+tmp2+tmp7, WA_LEFT,statx, WA_TOP,staty, WA_FLAGS,tmp3, WA_TITLE,stat.title_string, WA_CUSTOMSCREEN,stat.scr, WA_IDCMP,(BUTTONIDCMP OR IDCMP_REFRESHWINDOW), WA_NEWLOOKMENUS,TRUE, WA_AUTOADJUST,TRUE, NIL]) SetAPen(statwindow.rport,2) SetBPen(statwindow.rport,0) setafpt(statwindow.rport,[%1010101010101010,%0101010101010101]:INT,1) SetDrMd(statwindow.rport,RP_JAM2) RectFill(statwindow.rport,statwindow.borderleft,statwindow.bordertop,rightedge(statwindow)-1,bottomedge(statwindow)-1) setafpt(statwindow.rport,0,0) IF statwindow gaugeclass:=Init_gaugeiclass() gad:=CreateContext({glist}) tmp3:=(statwindow.width/2)-(tmp1/2) tmp4:=(statwindow.height-statwindow.borderbottom-tmp2-3) statgad,gad:=CreateGadgetA(BUTTON_KIND,gad, [tmp3-8,tmp4,tmp1+16,tmp2+2,stat.cancel_string,stat.textattr,1,0,vis,0]:newgadget,[NIL,NIL]) AddGList(statwindow,statgad,-1,-1,0) RefreshGList(statgad,statwindow,0,-1) disablegadget(statgad,statwindow) gaugeobj:=NewObjectA(gaugeclass,NIL, [IA_LEFT,statwindow.borderleft+2, IA_TOP,statwindow.bordertop+6+tmp7, IA_WIDTH,insidewidth(statwindow)-4, IA_HEIGHT,stath+4, GAUGEIA_TEXTFONT,stat.textfont, GAUGEIA_TEXTSTYLE,stat.textstyle, GAUGEIA_SCREEN,stat.scr, GAUGEIA_STYLE,GAUGETYPE_FANCY, TAG_END]) tmp1:=(statwindow.width/2)-(tmp8/2) tmp2:=statwindow.bordertop+2 drawbevelbox(vis,statwindow.rport,tmp1-6,tmp2,tmp8+12,tmp7+3,1,TRUE,0) Move(statwindow.rport,tmp1,stat.textfont.baseline+tmp2+1) SetAPen(statwindow.rport,1) SetFont(statwindow.rport,stat.textfont) Text(statwindow.rport,stat.status_string,StrLen(stat.status_string)) SetAttrsA(gaugeobj,[IA_DATA,stat.load_string,TAG_END]) DrawImageState(statwindow.rport,gaugeobj,0,0,IDS_INACTIVENORMAL,drawinfo) ENDIF ENDIF IF source<257 obj:=NewDTObjectA(source,[DTA_SOURCETYPE,DTST_CLIPBOARD,DTA_GROUPID,GID_PICTURE,PDTA_REMAP,FALSE,NIL,NIL]) ELSE obj:=NewDTObjectA(source,[DTA_SOURCETYPE,DTST_FILE,DTA_GROUPID,GID_PICTURE,PDTA_REMAP,FALSE,NIL,NIL]) ENDIF IF obj PutLong(dtf,DTM_FRAMEBOX) dtf.frameinfo:=fri dtf.contentsinfo:=fri dtf.sizeframeinfo:=SIZEOF frameinfo IF (domethod(obj,dtf)) PutLong(gpl,DTM_PROCLAYOUT) gpl.ginfo:=NIL gpl.initial:=1 IF (domethod(obj,gpl)) GetDTAttrsA(obj,[PDTA_CREGS,{cregs},PDTA_BITMAP,{bm},PDTA_BITMAPHEADER,{bmhd},PDTA_MODEID,{modeid},NIL,NIL]) IF (modeid AND HAM_KEY);hammode:=TRUE;ENDIF dtrast.bitmap:=bm IF usehighpen=256 THEN usehighpen:=-1 IF bm<>NIL body:=cregs FOR i:=0 TO (Shl(1,(bmhd.depth))-1) ditz:=body[0];body:=body+4;red[i]:=ditz dang:=body[0];body:=body+4;grn[i]:=dang dumb:=body[0];body:=body+4;blu[i]:=dumb ENDFOR grabbuf:=New(128) tbm:=AllocBitMap((bmhd.width*2),1,8,(BMF_CLEAR OR BMF_STANDARD),NIL) trast.bitmap:=tbm adjustw:=SpFlt(bmhd.width) adjusth:=SpFlt(bmhd.height) IF ((useaspect<>FALSE) AND (intscale=FALSE)) IF bmhd.xaspect=0 THEN bmhd.xaspect:=1 IF bmhd.yaspect=0 THEN bmhd.yaspect:=1 scalarx:=SpDiv(SpFlt(aspectx),SpFlt(bmhd.xaspect)) scalary:=SpDiv(SpFlt(aspecty),SpFlt(bmhd.yaspect)) res:=SpCmp(scalarx,scalary) IF res<0 -> scaraly is GREATER THAN scalarx percent:=SpDiv(scalarx,scalary) adjusth:=SpMul(percent,SpFlt(bmhd.height)) ELSE percent:=SpDiv(scalary,scalarx) adjustw:=SpMul(percent,SpFlt(bmhd.width)) ENDIF ENDIF finalx:=x;finaly:=y;finalw:=w;finalh:=h;scalex:=SpFlt(1);scaley:=SpFlt(1) res:=SpCmp(SpFlt(w),adjustw) res2:=SpCmp(SpFlt(h),adjusth) IF (((res<0) OR (res2<0)) AND (scale<>FALSE)) -> Datatype is LARGER than workspace, so scale? IF (intscale<>FALSE) scalex:=SpFlt(SpFix( SpDiv(SpFlt(w),SpFlt(SpFix(adjustw))))) scaley:=SpFlt(SpFix( SpDiv(SpFlt(h),SpFlt(SpFix(adjusth))))) res:=SpCmp(scalex,scaley) IF (res<0);scalef:=scaley;ELSE;scalef:=scalex;ENDIF finalw:=SpFix(SpDiv(scalef,adjustw)) finalh:=SpFix(SpDiv(scalef,adjusth)) ELSE scalex:=SpDiv(SpFlt(w),adjustw) scaley:=SpDiv(SpFlt(h),adjusth) res:=SpCmp(scalex,scaley) IF (res<0);scalef:=scaley;ELSE;scalef:=scalex;ENDIF finalw:=SpFix(SpDiv(scalef,adjustw)) finalh:=SpFix(SpDiv(scalef,adjusth)) ENDIF IF (stretch) finalw:=smaller(bmhd.width,w);finalh:=smaller(bmhd.height,h) -> finalw:=w;finalh:=h ENDIF xpixper:=SpDiv(SpFlt(finalw),SpFlt(bmhd.width)) ypixper:=SpDiv(SpFlt(finalh),SpFlt(bmhd.height)) ELSE finalw:=smaller(bmhd.width,w);finalh:=smaller(bmhd.height,h) xpixper:=SpFlt(1);ypixper:=SpFlt(1) ENDIF ->WriteF('\nfinalw=\d\nfinalh=\d\nxpixper=\d\nypixper=\d\n',finalw,finalh,SpFix(xpixper),SpFix(ypixper)) IF center finalx:=x+(w/2)-(finalw/2) finaly:=y+(h/2)-(finalh/2) ENDIF IF statgad THEN enablegadget(statgad,statwindow) IF ((remap=FALSE) AND (scale=FALSE)) FOR t:=0 TO finalh-1 IF checkcancel(statwindow) THEN Raise("canc") IF (((t+3)/4) = (t/4)) IF gaugeobj THEN fuelgauge(statwindow.rport,gaugeobj,t,finalh-1,stat.render_string,drawinfo) ENDIF FOR i:=0 TO finalw-1 fc:=ReadPixel(dtrast,i,t) WHILE fc>usehighpen fc:=Shr(fc,1) ENDWHILE IF highpen<fc THEN highpen:=fc SetAPen(rast,fc) WritePixel(rast,finalx+i,finaly+t) ENDFOR ENDFOR ELSE redbuf:=New(bmhd.width*(SpFix(ypixper)*4)*2) grnbuf:=New(bmhd.width*(SpFix(ypixper)*4)*2) blubuf:=New(bmhd.width*(SpFix(ypixper)*4)*2) linebuf:=New(bmhd.width*8) sfixx:=SpFix(xpixper)-1 sfixy:=SpFix(ypixper)-1 red24:=New(finalw*(finalh+16)) grn24:=New(finalw*(finalh+16)) blu24:=New(finalw*(finalh+16)) FOR t:=0 TO (finalh-1) IF checkcancel(statwindow) THEN Raise("canc") IF (((t+3)/4) = (t/4)) IF gaugeobj THEN fuelgauge(statwindow.rport,gaugeobj,t,finalh-1,stat.scale_string,drawinfo) ENDIF FOR u:=t TO t+SpFix(ypixper)-1 ReadPixelLine8(dtrast,0,SpFix(SpMul(SpFlt(t),ypixper))+(u-t),bmhd.width,linebuf,trast) speed8:=linebuf[0] tmp1:=red[speed8];tmp2:=grn[speed8];tmp3:=blu[speed8] IF (hammode) tmp1:=red[0];tmp2:=grn[0];tmp3:=blu[0] IF bmhd.depth=8 -> HAM8 IF (speed8 AND %11000000) IF ((speed8 AND %11000000)=%10000000) -> Modify RED tmp1:=Shl((speed8 AND %111111),2);ENDIF IF ((speed8 AND %11000000)=%01000000) -> Modify BLUE tmp3:=Shl((speed8 AND %111111),2);ENDIF IF ((speed8 AND %11000000)=%11000000) -> Modify GRN tmp2:=Shl((speed8 AND %111111),2);ENDIF ELSE tmp1:=red[(speed8 AND %111111)];tmp2:=grn[(speed8 AND %111111)];tmp3:=blu[(speed8 AND %111111)] ENDIF ELSE IF (speed8 AND %110000) IF (speed8 AND %110000)=%100000 -> Modify RED tmp1:=Shl((speed8 AND %1111),4);ENDIF IF (speed8 AND %110000)=%010000 -> Modify BLUE tmp3:=Shl((speed8 AND %1111),4);ENDIF IF (speed8 AND %110000)=%110000 -> Modify GRN tmp2:=Shl((speed8 AND %1111),4);ENDIF ELSE tmp1:=red[(z AND %1111)];tmp2:=grn[(z AND %1111)];tmp3:=blu[(z AND %1111)] ENDIF ENDIF ENDIF speed1:=bmhd.width*(u-t) ditz:=redbuf+speed1 dang:=grnbuf+speed1 dumb:=blubuf+speed1 IF (remap=FALSE) THEN ditz:=redbuf FOR v:=1 TO bmhd.width IF (remap=FALSE) ditz[0]:=linebuf[v];ditz:=ditz+1 ELSE /* MOVE.L tmp1,D0 MOVE.L tmp2,D1 MOVE.L tmp3,D2 LEA ditz,A1 MOVE.L (A1),A0 MOVE.B D0,(A0)+ MOVE.L A0,(A1) LEA dang,A1 MOVE.L (A1),A0 MOVE.B D1,(A0)+ MOVE.L A0,(A1) LEA dumb,A1 MOVE.L (A1),A0 MOVE.B D2,(A0)+ MOVE.L A0,(A1) */ ditz[0]:=tmp1;ditz:=ditz+1 dang[0]:=tmp2;dang:=dang+1 dumb[0]:=tmp3;dumb:=dumb+1 /* MOVE.L linebuf,A0 MOVE.L v,D0 SUB.L D1,D1 MOVE.B 0(A0,D0),D1 MOVE.L D1,z */ z:=linebuf[v] IF (hammode=FALSE) tmp1:=red[z];tmp2:=grn[z];tmp3:=blu[z] ELSE IF (bmhd.depth=8) -> HAM8 speed7:=(z AND %11000000) IF (speed7) IF (speed7=%10000000) -> Modify RED tmp1:=Shl((z AND %111111),2) ELSE IF (speed7=%01000000) tmp3:=Shl((z AND %111111),2) ELSE tmp2:=Shl((z AND %111111),2) ENDIF ENDIF ELSE speed6:=(z AND %111111) tmp1:=red[speed6];tmp2:=grn[speed6];tmp3:=blu[speed6] ENDIF ELSE IF (z AND %110000) IF (z AND %110000)=%100000 -> Modify RED tmp1:=Shl((z AND %1111),4);ENDIF IF (z AND %110000)=%010000 -> Modify BLUE tmp3:=Shl((z AND %1111),4);ENDIF IF (z AND %110000)=%110000 -> Modify GRN tmp2:=Shl((z AND %1111),4);ENDIF ELSE speed6:=(z AND %1111) tmp1:=red[speed6];tmp2:=grn[speed6];tmp3:=blu[speed6] ENDIF ENDIF ENDIF ENDIF ENDFOR ENDFOR IF (remap=FALSE) FOR i:=0 TO finalw-1 fc:=Char(redbuf+(SpFix(SpMul(xpixper,SpFlt(i))))) SetAPen(rast,fc) highpen:=bigger(highpen,fc) WritePixel(rast,finalx+i,finaly+t) ENDFOR ELSE FOR i:=0 TO finalw-1 tmp4:=(SpFix(SpMul(xpixper,SpFlt(i)))) ditz:=redbuf+tmp4 dang:=grnbuf+tmp4 dumb:=blubuf+tmp4 IF ((sfixy>=1) AND (sfixx>=1)) num:=0;sumred:=0;sumgrn:=0;sumblu:=0 MOVEM.L D0-D7/A0-A3,-(A7) MOVE.L ditz,A0 MOVE.L dang,A1 MOVE.L dumb,A2 MOVE.L bmhd,A3 CLR.L D2 -> The result from Char() CLR.L D4 -> num CLR.L D5 -> sumred CLR.L D6 -> sumgrn CLR.L D7 -> sumblu MOVE.L sfixy,D0 -> ADD.L #1,D0 loop3: MOVE.L sfixx,D1 -> ADD.L #1,D1 loop2: SUB.L D3,D3 -> EQ: CLR.L D3 ? Is it faster??!? MOVE.W 0(A3),D3 MULU D0,D3 ADD.L D1,D3 MOVE.B 0(A0,D3),D2 ADD.L D2,D5 MOVE.B 0(A1,D3),D2 ADD.L D2,D6 MOVE.B 0(A2,D3),D2 ADD.L D2,D7 ADDQ.L #1,D4 DBRA D1,loop2 DBRA D0,loop3 MOVE.L D4,num MOVE.L D5,sumred MOVE.L D6,sumgrn MOVE.L D7,sumblu MOVEM.L (A7)+,D0-D7/A0-A3 IF num>0 sumred:=limit(sumred/num,0,255) sumgrn:=limit(sumgrn/num,0,255) sumblu:=limit(sumblu/num,0,255) ENDIF ELSE sumred:=ditz[0] sumgrn:=dang[0] sumblu:=dumb[0] ENDIF MOVE.L t,D1 MOVE.L finalw,D2 MULU D2,D1 ADD.L i,D1 MOVE.L D1,D0 ADD.L red24,D0 MOVE.L D0,A0 MOVE.L sumred,D2 MOVE.B D2,(A0) MOVE.L D1,D0 ADD.L grn24,D0 MOVE.L D0,A0 MOVE.L sumgrn,D2 MOVE.B D2,(A0) MOVE.L D1,D0 ADD.L blu24,D0 MOVE.L D0,A0 MOVE.L sumblu,D2 MOVE.B D2,(A0) ENDFOR ENDIF ENDFOR IF showsize THEN mergesize(showsize,bmhd.width,bmhd.height,red24,grn24,blu24,finalw,finalh) IF grey tmp1:=red24 tmp2:=grn24 tmp3:=blu24 tmp7:=finalh*finalw-1 FOR i:=0 TO tmp7 IF grey=1 er1:=(tmp1[0]*1000)/30 er2:=(tmp2[0]*1000)/30 er3:=(tmp3[0]*1000)/30 ELSE er1:=(tmp1[0]*3000)/100 er2:=(tmp2[0]*6000)/100 er3:=(tmp3[0]*1000)/100 ENDIF er4:=(er1+er2+er3)/100 tmp1[0]:=er4 tmp2[0]:=er4 tmp3[0]:=er4 tmp1:=tmp1+1 tmp2:=tmp2+1 tmp3:=tmp3+1 ENDFOR ENDIF IF (fillcmap) IF usehighpen>=quant THEN usehighpen:=(quant-1) SELECT QUANT_END OF quantmode CASE QUANT_VERBATIM FOR i:=0 TO quant SetRGB32CM(cmap,smaller(i,255),byte2long(red[i]),byte2long(grn[i]),byte2long(blu[i])) ENDFOR CASE QUANT_POPULARITY histo:=New(20000) FOR t:=0 TO finalh-1 IF checkcancel(statwindow) THEN Raise("canc") IF ((t/4)=((t+3)/4)) IF gaugeobj THEN fuelgauge(statwindow.rport,gaugeobj,t,finalh-1,stat.histogram_string,drawinfo) ENDIF FOR i:=0 TO finalw-1 tmp1:=Shr((Char(red24+(t*finalw)+i) AND $F0) ,4) tmp2:=Shr((Char(grn24+(t*finalw)+i) AND $F0) ,4) tmp3:=Shr((Char(blu24+(t*finalw)+i) AND $F0) ,4) tmp4:=histo+((tmp1+(tmp2*16)+(tmp3*256))*4) tmp4[0]:=tmp4[0]+1 ENDFOR ENDFOR FOR i:=0 TO quant IF checkcancel(statwindow) THEN Raise("canc") IF gaugeobj THEN fuelgauge(statwindow.rport,gaugeobj,i,quant,stat.quant_string,drawinfo) tmp1:=0 tmp2:=0 longptr:=histo FOR t:=0 TO 4095 IF longptr[0]>tmp2 tmp2:=longptr[0] tmp1:=t ENDIF longptr:=longptr+4 ENDFOR histo[tmp1]:=0 er1:=tmp1 AND $F er1:=er1 OR Shl(er1,4) er2:=Shr((tmp1 AND $F0),4) er2:=er2 OR Shl(er2,4) er3:=Shr((tmp1 AND $F00),8) er3:=er3 OR Shl(er3,4) SetRGB32CM(cmap,smaller(i,255),byte2long(er1),byte2long(er2),byte2long(er3)) ENDFOR DEFAULT cm:=domediancut(red24,grn24,blu24,finalw,finalh,cmap,quant,quantmode) IF (cm) FOR i:=0 TO (quant) SetRGB32CM(cmap,smaller(i,255),byte2long(PPM_GETR(Long(cm+(i*SIZEOF colorhist_item)))),byte2long(PPM_GETG(Long(cm+(i*SIZEOF colorhist_item)))),byte2long(PPM_GETB(Long(cm+(i*SIZEOF colorhist_item))))) ENDFOR Dispose(cm) ENDIF ENDSELECT IF ((quant>4) AND (quantmode<>QUANT_VERBATIM)) doexchange(cmap,3,0,255,255,usehighpen) doexchange(cmap,2,255,255,255,usehighpen) doexchange(cmap,1,0,0,0,usehighpen) doexchange(cmap,0,128,128,128,usehighpen) REPEAT tmp1:=0 FOR i:=4 TO (quant-1) GetRGB32(cmap,i,2,grabbuf) IF ((grabbuf[0]+grabbuf[4]+grabbuf[8])<(grabbuf[12]+grabbuf[16]+grabbuf[20])) SetRGB32CM(cmap,smaller(i+1,255),byte2long(grabbuf[0]),byte2long(grabbuf[4]),byte2long(grabbuf[8])) SetRGB32CM(cmap,smaller(i,255),byte2long(grabbuf[12]),byte2long(grabbuf[16]),byte2long(grabbuf[20])) tmp1:=1 ENDIF ENDFOR UNTIL tmp1=0 ENDIF ENDIF IF (norender) THEN Raise("nore") IF (clear<>FALSE);SetAPen(rast,0);RectFill(rast,x,y,x+w-1,y+h-1);ENDIF FOR i:=0 TO Shl(1,8)-1 GetRGB32(cmap,i,1,grabbuf) realred[i]:=grabbuf[0] realgrn[i]:=grabbuf[4] realblu[i]:=grabbuf[8] ENDFOR IF renderham THEN dither:=FALSE ->WriteF('\nfinalw=\d\nfinalh=\d\nxpixper=\d\nypixper=\d\n',finalw,finalh,SpFix(xpixper),SpFix(ypixper)) FOR t:=0 TO finalh-1 IF checkcancel(statwindow) THEN Raise("canc") IF (((t+3)/4)=(t/4)) IF (gaugestr<>0) WriteF(gaugestr,smaller(((t*100))/(bigger(finalh-1,1)),100)) ENDIF IF gaugeobj THEN fuelgauge(statwindow.rport,gaugeobj,t,finalh-1,stat.render_string,drawinfo) ENDIF IF ((((t+1)/2)=(t/2)) OR (renderham>5) OR (dithermode=DITH_ERRORDIFF)) i:=0;stop:=finalw;step:=1 tmp4:=t*finalw tmp1:=red24+tmp4 tmp2:=grn24+tmp4 tmp3:=blu24+tmp4 ELSE i:=finalw-1;stop:=-1;step:=-1 tmp4:=(t*finalw)+(finalw-1) tmp1:=red24+tmp4 tmp2:=grn24+tmp4 tmp3:=blu24+tmp4 ENDIF REPEAT tmp4:=tmp1[0] tmp5:=tmp2[0] tmp6:=tmp3[0] lmp4:=byte2long(tmp4) lmp5:=byte2long(tmp5) lmp6:=byte2long(tmp6) IF (dither=FALSE) SELECT 9 OF renderham CASE 6,8 IF (i>0) fc:=FindColor(cmap,lmp4,lmp5,lmp6,hambase) hadr:=Abs(tmp4-realred[fc]) hadg:=Abs(tmp5-realgrn[fc]) hadb:=Abs(tmp6-realblu[fc]) IF ((hadr+hadg+hadb)<=hamthres) hamr:=realred[fc] -> CHAR hamg:=realgrn[fc] hamb:=realblu[fc] ELSE hadr:=Abs(tmp4-hamr) -> CHAR-CHAR hadg:=Abs(tmp5-hamg) hadb:=Abs(tmp6-hamb) IF (renderham=8) IF ((hadb>(hadr*2)) AND (hadb>(hadg*3))) hamb:=(tmp6 AND %11111100) fc:=(%01000000 OR Shr(hamb,2)) IF (discard) THEN hamb:=(tmp6 AND %11111111) ELSE IF (hadr>(hadg*2)) hamr:=(tmp4 AND %11111100) fc:=(%10000000 OR Shr(hamr,2)) IF (discard) THEN hamr:=(tmp4 AND %11111111) ELSE hamg:=(tmp5 AND %11111100) fc:=(%11000000 OR Shr(hamg,2)) IF (discard) THEN hamg:=(tmp5 AND %11111111) ENDIF ENDIF ELSE IF ((hadb>(hadr*2)) AND (hadb>(hadg*3))) hamb:=(tmp6 AND %11110000) fc:=(%010000 OR Shr(hamb,4)) IF (discard) THEN hamb:=(tmp6 AND %11111111) ELSE IF (hadr>(hadg*2)) hamr:=(tmp4 AND %11110000) fc:=(%100000 OR Shr(hamr,4)) IF (discard) THEN hamr:=(tmp4 AND %11111111) ELSE hamg:=(tmp5 AND %11110000) fc:=(%110000 OR Shr(hamg,4)) IF (discard) THEN hamg:=(tmp5 AND %11111111) ENDIF ENDIF ENDIF ENDIF ELSE fc:=FindColor(cmap,lmp4,lmp5,lmp6,hambase) hamr:=realred[fc] hamg:=realgrn[fc] hamb:=realblu[fc] ENDIF DEFAULT fc:=FindColor(cmap,lmp4,lmp5,lmp6,usehighpen) ENDSELECT IF fc>highpen THEN highpen:=fc SetAPen(rast,fc) WritePixel(rast,finalx+i,finaly+t) ELSE -> Do dither! fc:=FindColor(cmap,lmp4,lmp5,lmp6,usehighpen) IF fc>highpen THEN highpen:=fc SetAPen(rast,fc) WritePixel(rast,finalx+i,finaly+t) reddif:=tmp4-realred[fc] grndif:=tmp5-realgrn[fc] bludif:=tmp6-realblu[fc] SELECT 4 OF dithermode CASE DITH_FLOYD,DITH_ERRORDIFF IF dithermode=DITH_FLOYD er1:=(reddif*7)/16 er2:=(reddif*3)/16 er3:=(reddif*5)/16 er4:=reddif-er1-er2-er3 eg1:=(grndif*7)/16 eg2:=(grndif*3)/16 eg3:=(grndif*5)/16 eg4:=grndif-eg1-eg2-eg3 eb1:=(bludif*7)/16 eb2:=(bludif*3)/16 eb3:=(bludif*5)/16 eb4:=bludif-eb1-eb2-eb3 ELSE er1:=(reddif*3)/8 AND %11111111111111111111111111111110 er2:=0 er3:=er1 er4:=reddif-er1-er3 AND %11111111111111111111111111111100 eg1:=(grndif*3)/8 AND %11111111111111111111111111111100 eg2:=0 eg3:=eg1 eg4:=grndif-eg1-eg3 AND %11111111111111111111111111111100 eb1:=(bludif*3)/8 AND %11111111111111111111111111111110 eb2:=0 eb3:=eb1 eb4:=bludif-eb1-eb3 AND %11111111111111111111111111111100 ENDIF IF step=1 IF ((i+1)<stop) byteplace(tmp1+1,er1) byteplace(tmp2+1,eg1) byteplace(tmp3+1,eb1) ENDIF IF t<(finalh-1) IF ((i+1)<stop) byteplace(tmp1+1+finalw,er4) byteplace(tmp2+1+finalw,eg4) byteplace(tmp3+1+finalw,eb4) ENDIF IF (i>0) byteplace(tmp1-1+finalw,er2) byteplace(tmp2-1+finalw,eg2) byteplace(tmp3-1+finalw,eb2) ENDIF byteplace(tmp1+finalw,er3) byteplace(tmp2+finalw,eg3) byteplace(tmp3+finalw,eb3) ENDIF ELSE IF ((i-1)>stop) byteplace(tmp1-1,er1) byteplace(tmp2-1,eg1) byteplace(tmp3-1,eb1) ENDIF IF t<(finalh-1) IF ((i-1)>stop) byteplace(tmp1-1+finalw,er4) byteplace(tmp2-1+finalw,eg4) byteplace(tmp3-1+finalw,eb4) ENDIF IF (i<(finalw-1)) byteplace(tmp1+1+finalw,er2) byteplace(tmp2+1+finalw,eg2) byteplace(tmp3+1+finalw,eb2) ENDIF byteplace(tmp1+finalw,er3) byteplace(tmp2+finalw,eg3) byteplace(tmp3+finalw,eb3) ENDIF ENDIF CASE DITH_BURKES,DITH_STUCKI IF dithermode=DITH_BURKES er1:=(reddif*8)/32 ->8 er2:=(reddif*4)/32 ->4 er3:=(reddif-(er1*2)-(er2*3))/2 ->2 eg1:=(grndif*8)/32 eg2:=(grndif*4)/32 eg3:=(grndif-(eg1*2)-(eg2*3))/2 eb1:=(bludif*8)/32 eb2:=(bludif*4)/32 eb3:=(bludif-(eb1*2)-(eb2*3))/2 ELSE er1:=(reddif*8)/42 ->8 er2:=(reddif*4)/42 ->4 er3:=(reddif*2)/42 ->2 er4:=(reddif-(er1*2)-(er2*4)-(er3*4))/2 ->1 eg1:=(grndif*8)/42 eg2:=(grndif*4)/42 eg3:=(grndif*2)/42 eg4:=(grndif-(eg1*2)-(eg2*4)-(eg3*4))/2 eb1:=(bludif*8)/42 eb2:=(bludif*4)/42 eb3:=(bludif*2)/42 eb4:=(bludif-(eb1*2)-(eb2*4)-(eb3*4))/2 ENDIF IF step=1 IF ((i+1)<stop) byteplace(tmp1+1,er1) byteplace(tmp2+1,eg1) byteplace(tmp3+1,eb1) IF ((i+2)<stop) byteplace(tmp1+2,er2) byteplace(tmp2+2,eg2) byteplace(tmp3+2,eb2) ENDIF ENDIF IF t<(finalh-1) ttmp1:=tmp1+finalw ttmp2:=tmp2+finalw ttmp3:=tmp3+finalw IF ((i+1)<stop) byteplace(ttmp1+1,er2) byteplace(ttmp2+1,eg2) byteplace(ttmp3+1,eb2) IF ((i+2)<stop) byteplace(ttmp1+2,er3) byteplace(ttmp2+2,eg3) byteplace(ttmp3+2,eb3) ENDIF ENDIF IF (i>0) byteplace(ttmp1-1,er2) byteplace(ttmp2-1,eg2) byteplace(ttmp3-1,eb2) IF (i>1) byteplace(ttmp1-2,er3) byteplace(ttmp2-2,eg3) byteplace(ttmp3-2,eb3) ENDIF ENDIF byteplace(ttmp1,er1) byteplace(ttmp2,eg1) byteplace(ttmp3,eb1) IF dithermode=DITH_STUCKI IF t<(finalh-1) ttmp1:=ttmp1+finalw ttmp2:=ttmp2+finalw ttmp3:=ttmp3+finalw IF ((i+1)<stop) byteplace(ttmp1+1,er3) byteplace(ttmp2+1,eg3) byteplace(ttmp3+1,eb3) IF ((i+2)<stop) byteplace(ttmp1+2,er4) byteplace(ttmp2+2,eg4) byteplace(ttmp3+2,eb4) ENDIF ENDIF IF (i>0) byteplace(ttmp1-1,er3) byteplace(ttmp2-1,eg3) byteplace(ttmp3-1,eb3) IF (i>1) byteplace(ttmp1-2,er4) byteplace(ttmp2-2,eg4) byteplace(ttmp3-2,eb4) ENDIF ENDIF byteplace(ttmp1,er2) byteplace(ttmp2,eg2) byteplace(ttmp3,eb2) ENDIF ENDIF ENDIF ELSE IF ((i-1)>stop) byteplace(tmp1-1,er1) byteplace(tmp2-1,eg1) byteplace(tmp3-1,eb1) IF ((i-2)>stop) byteplace(tmp1-2,er2) byteplace(tmp2-2,eg2) byteplace(tmp3-2,eb2) ENDIF ENDIF IF t<(finalh-1) ttmp1:=tmp1+finalw ttmp2:=tmp2+finalw ttmp3:=tmp3+finalw IF ((i-1)>stop) byteplace(ttmp1-1,er2) byteplace(ttmp2-1,eg2) byteplace(ttmp3-1,eb2) IF ((i-2)>stop) byteplace(ttmp1-2,er3) byteplace(ttmp2-2,eg3) byteplace(ttmp3-2,eb3) ENDIF ENDIF IF (i<(finalw-1)) byteplace(ttmp1+1,er2) byteplace(ttmp2+1,eg2) byteplace(ttmp3+1,eb2) IF (i<(finalw-2)) byteplace(ttmp1+2,er3) byteplace(ttmp2+2,eg3) byteplace(ttmp3+2,eb3) ENDIF ENDIF byteplace(ttmp1,er1) byteplace(ttmp2,eg1) byteplace(ttmp3,eb1) IF dithermode=DITH_STUCKI IF (t<(finalh-1)) ttmp1:=ttmp1+finalw ttmp2:=ttmp2+finalw ttmp3:=ttmp3+finalw IF ((i-1)>stop) byteplace(ttmp1-1,er3) byteplace(ttmp2-1,eg3) byteplace(ttmp3-1,eb3) IF ((i-2)>stop) byteplace(ttmp1-2,er4) byteplace(ttmp2-2,eg4) byteplace(ttmp3-2,eb4) ENDIF ENDIF IF (i<(finalw-1)) byteplace(ttmp1+1,er3) byteplace(ttmp2+1,eg3) byteplace(ttmp3+1,eb3) IF (i<(finalw-2)) byteplace(ttmp1+2,er4) byteplace(ttmp2+2,eg4) byteplace(ttmp3+2,eb4) ENDIF ENDIF byteplace(ttmp1,er2) byteplace(ttmp2,eg2) byteplace(ttmp3,eb2) ENDIF ENDIF ENDIF ENDIF ENDSELECT ENDIF tmp1:=tmp1+step tmp2:=tmp2+step tmp3:=tmp3+step i:=i+step;UNTIL i=stop ENDFOR ENDIF IF (renderham=6) THEN highpen:=63 IF (renderham=8) THEN highpen:=255 IF iinfo iinfo.source_w:=bmhd.width iinfo.source_h:=bmhd.height iinfo.destination_x:=finalx iinfo.destination_y:=finaly iinfo.destination_w:=finalw iinfo.destination_h:=finalh iinfo.depth:=bmhd.depth iinfo.highest_pen:=highpen IF ((renderham=6) OR (renderham=8)) THEN usehighpen:=3 iinfo.blackpen:=FindColor(cmap,0,0,0,usehighpen) iinfo.whitepen:=FindColor(cmap,$FFFFFFFF,$FFFFFFFF,$FFFFFFFF,usehighpen) iinfo.greypen:=FindColor(cmap,$99999999,$99999999,$99999999,usehighpen) IF statwindow iinfo.statwindowx:=stat.centerx-(statx-statwindow.leftedge) iinfo.statwindowy:=stat.centery-(staty-statwindow.topedge) ENDIF ENDIF IF (gaugestr<>0) WriteF(gaugestr,100) ENDIF ELSE Raise("MEM") ENDIF ELSE Raise("Nodt") ENDIF ELSE Raise("Nodt") ENDIF ELSE Raise("Nodt") ENDIF EXCEPT DO res:=exception IF statwindow CloseWindow(statwindow) IF glist FreeGadgets(glist) ENDIF statwindow:=0 ENDIF IF gaugeobj THEN DisposeObject(gaugeobj) IF vis THEN FreeVisualInfo(vis) IF obj THEN DisposeDTObject(obj) IF tbm THEN FreeBitMap(tbm) IF redbuf THEN Dispose(redbuf) IF grnbuf THEN Dispose(grnbuf) IF blubuf THEN Dispose(blubuf) IF linebuf THEN Dispose(linebuf) IF grabbuf THEN Dispose(grabbuf) IF trast THEN Dispose(trast) IF dtf THEN Dispose(dtf) IF fri THEN Dispose(fri) IF histo THEN Dispose(histo) IF red24 THEN Dispose(red24) IF grn24 THEN Dispose(grn24) IF blu24 THEN Dispose(blu24) IF gpl THEN Dispose(gpl) IF dtrast THEN Dispose(dtrast) IF gaugeclass THEN Free_gaugeiclass(gaugeclass) ENDPROC res PROC checklibs() IF ((iffparsebase<>0) AND (utilitybase<>0) AND (datatypesbase<>0) AND (mathbase<>0) AND (gaugeimagebase<>0)) THEN RETURN TRUE ENDPROC FALSE PROC checkcancel(window:PTR TO window) DEF mes:PTR TO intuimessage DEF class DEF retu=FALSE IF window REPEAT IF mes:=Gt_GetIMsg(window.userport) class:=extractmessage(mes) IF (class=IDCMP_GADGETUP) retu:=TRUE ELSEIF class=IDCMP_REFRESHWINDOW Gt_BeginRefresh(window) Gt_EndRefresh(window,TRUE) ENDIF Gt_ReplyIMsg(mes) ENDIF UNTIL mes=0 ELSE IF CtrlC() THEN retu:=TRUE ENDIF ENDPROC retu PROC byteplace(loc:PTR TO CHAR,error) DEF old old:=loc[0] old:=old+error IF old<0 THEN old:=0 IF old>255 THEN old:=255 loc[0]:=old ENDPROC /*PROC rgbint(intval) DEF r,g,b r:=intval AND $F r:=r OR Shl(r,4) g:=Shr((intval AND $F0),4) g:=g OR Shl(g,4) b:=Shr((intval AND $F00),8) b:=b OR Shl(b,4) ENDPROC r,g,b*/ /*PROC rgb2int(r,g,b) DEF int=0 int:=(Shr(r,4) OR (Shl(Shr(g,4),4)) OR (Shl(Shr(b,4),8)) ) ENDPROC int*/ /*PROC rgbtab(r,g,b) DEF rr rr:=(r+(g*16)+(b*256))*4 ENDPROC rr*/ PROC domediancut(redbuf,grnbuf,blubuf,width,height,palette,newcolors,mode=QUANT_MEDIANCUT) DEF chv=0:PTR TO colorhist_item DEF colors=0 DEF colormap histopool:=createpool() chv:=computecolorhist(redbuf,grnbuf,blubuf,width,height,MAXCOLORS,{colors}) IF chv -> WriteF('\n\nFOUND \d COLORS! -- Choosing \d colors...\n\n',colors,newcolors) colormap:=mediancut(chv,colors,width*height,newcolors,mode) Dispose(chv) ENDIF ENDPROC colormap PROC mediancut(chv,colors,sum,newcolors,mode=QUANT_MEDIANCUT) DEF colormap=0,bv=0 DEF boxes,bi,i,i2,realsplit,bigbox,movebox,tmp1,tmp2,score DEF box:PTR TO box,chi:PTR TO colorhist_item DEF indx,clrs,sm,v,halfcolor,halfsum,lowersum DEF r,g,b,rsum,gsum,bsum DEF rl,gl,bl DEF f_0_299,f_0_587,f_0_114 DEF colo bv:=New((SIZEOF box*newcolors)+100) f_0_299:=SpDiv(SpFlt(1000),SpFlt(299)) f_0_587:=SpDiv(SpFlt(1000),SpFlt(587)) f_0_114:=SpDiv(SpFlt(1000),SpFlt(114)) IF (bv) colormap:=New((SIZEOF colorhist_item*newcolors)+100) IF (colormap) FOR i:=0 TO (newcolors-1) PutLong(colormap+(i*SIZEOF colorhist_item),0) PutLong(colormap+(i*SIZEOF colorhist_item)+4,0) ENDFOR box:=bv box.ind:=0 box.colors:=colors box.sum:=sum boxes:=1 sizebox(box,chv) WHILE (boxes<newcolors) IF checkcancel(statwindow) IF chv THEN Dispose(chv) IF bv THEN Dispose(bv) IF colormap THEN Dispose(colormap) Raise("canc") ENDIF IF gaugeobj THEN fuelgauge(statwindow.rport,gaugeobj,boxes,newcolors,stat.quant_string,drawinfo) FOR bi:=0 TO (boxes-1) box:=bv+(bi*SIZEOF box) IF box.colors>=2 THEN JUMP break2 ENDFOR JUMP break3 break2: indx:=box.ind clrs:=box.colors sm:=box.sum SELECT QUANT_END OF mode /* CASE QUANT_MEDIANCUT rl:=SpMul(SpFlt(box.redw),f_0_299) gl:=SpMul(SpFlt(box.grnw),f_0_587) bl:=SpMul(SpFlt(box.bluw),f_0_114) */ CASE QUANT_MEDIANCUT4,QUANT_MEDIANCUT2,QUANT_MEDIANCUT3 rl:=SpFlt(box.redw) gl:=SpFlt(box.grnw) bl:=SpFlt(box.bluw) DEFAULT rl:=SpMul(SpFlt(18),SpFlt(box.redw)) gl:=SpMul(SpFlt(20),SpFlt(box.grnw)) bl:=SpMul(SpFlt(17),SpFlt(box.bluw)) ENDSELECT IF ((SpCmp(gl,rl)>=0) AND (SpCmp(gl,bl)>=0)) qsort(chv+(indx*SIZEOF colorhist_item),0,clrs-1,$FF00) v:=1 ELSE IF (SpCmp(rl,bl)>=0) qsort(chv+(indx*SIZEOF colorhist_item),0,clrs-1,$FF0000) v:=0 ELSE qsort(chv+(indx*SIZEOF colorhist_item),0,clrs-1,$FF) v:=2 ENDIF ENDIF chi:=chv+(indx*SIZEOF colorhist_item) lowersum:=chi.value halfsum:=(sm/2) i:=1 WHILE (i<(clrs-1)) IF (lowersum>=halfsum) SELECT v CASE 0 gsum:=PPM_GETR(chi.color) IF gsum>rsum THEN JUMP break4 CASE 1 gsum:=PPM_GETG(chi.color) IF gsum>rsum THEN JUMP break4 CASE 2 gsum:=PPM_GETB(chi.color) IF gsum>rsum THEN JUMP break4 ENDSELECT ENDIF chi:=chv+((indx+i)*SIZEOF colorhist_item) IF (lowersum<halfsum) SELECT v CASE 0;rsum:=PPM_GETR(chi.color) CASE 1;rsum:=PPM_GETG(chi.color) CASE 2;rsum:=PPM_GETB(chi.color) ENDSELECT ENDIF lowersum:=lowersum+(chi.value) i:=i+1;ENDWHILE ->WriteF('\n\nOUCH! GOT ALL COLORS!') break4: i2:=1 WHILE (i2<(clrs-1)) SELECT v CASE 0;IF (PPM_GETR(chi.color)>(box.red0+(box.redw/2))) THEN JUMP break8 CASE 1;IF (PPM_GETG(chi.color)>(box.grn0+(box.grnw/2))) THEN JUMP break8 CASE 2;IF (PPM_GETB(chi.color)>(box.blu0+(box.bluw/2))) THEN JUMP break8 ENDSELECT chi:=chv+((indx+i)*SIZEOF colorhist_item) i2:=i2+1;ENDWHILE ->WriteF('\n\nOUCH! GOT ALL COLORS!') break8: SELECT QUANT_END OF mode CASE QUANT_MEDIANCUT;realsplit:=i CASE QUANT_MEDIANCUT5;realsplit:=i2 DEFAULT;realsplit:=limit((i+i2)/2,1,(clrs-1)) ENDSELECT ->WriteF('\nSplit at \d AND \d, really at \d',i,i2,realsplit) lowersum:=0 FOR i:=0 TO realsplit chi:=chv+((indx+i)*SIZEOF colorhist_item) lowersum:=lowersum+chi.value ENDFOR lowersum:=limit(lowersum,0,sm-1) box:=bv+(bi*SIZEOF box) box.colors:=realsplit box.sum:=lowersum sizebox(box,chv) box:=bv+(boxes*SIZEOF box) box.ind:=indx+realsplit box.colors:=clrs-realsplit box.sum:=sm-lowersum sizebox(box,chv) boxes:=boxes+1 bigbox:=0;movebox:=0 box:=(bv-SIZEOF box) /* Find the largest box to split, and move it to position ZERO. */ FOR i:=0 TO boxes-1 box:=(box+SIZEOF box) IF (box.colors>1) SELECT QUANT_END OF mode CASE QUANT_MEDIANCUT IF (box.redw)>bigbox bigbox:=box.redw movebox:=i ENDIF IF (box.grnw)>bigbox bigbox:=box.grnw movebox:=i ENDIF IF (box.bluw)>bigbox bigbox:=box.bluw movebox:=i ENDIF CASE QUANT_MEDIANCUT2 score:=(((box.redw*box.redw))+((box.grnw*box.grnw))+(box.bluw*box.bluw)) IF score>bigbox;movebox:=i;bigbox:=score;ENDIF CASE QUANT_MEDIANCUT3 IF (boxes<(newcolors/3)) IF (box.colors>bigbox);movebox:=i;bigbox:=box.colors;ENDIF ELSE IF (boxes<((newcolors*2)/3)) score:=((box.redw)*(box.grnw)*(box.bluw)) IF (score>bigbox);movebox:=i;bigbox:=score;ENDIF ELSE IF (box.redw)>bigbox bigbox:=box.redw movebox:=i ENDIF IF (box.grnw)>bigbox bigbox:=box.grnw movebox:=i ENDIF IF (box.bluw)>bigbox bigbox:=box.bluw movebox:=i ENDIF ENDIF ENDIF CASE QUANT_MEDIANCUT4 IF (boxes*2<=newcolors) IF (box.colors>bigbox) bigbox:=box.colors movebox:=i ENDIF ELSE IF (box.redw*box.grnw*box.bluw)>bigbox bigbox:=(box.redw*box.grnw*box.bluw) movebox:=i ENDIF ENDIF CASE QUANT_MEDIANCUT5 IF (((box.redw*box.colors)>bigbox)) bigbox:=box.redw*box.colors movebox:=i ENDIF IF (((box.grnw*box.colors)>bigbox)) bigbox:=box.grnw*box.colors movebox:=i ENDIF IF (((box.bluw*box.colors)>bigbox)) bigbox:=box.bluw*box.colors movebox:=i ENDIF CASE QUANT_MEDIANCUT6 IF (((box.redw*box.colors*box.sum)>bigbox)) bigbox:=box.redw*box.colors*box.sum movebox:=i ENDIF IF (((box.grnw*box.colors*box.sum)>bigbox)) bigbox:=box.grnw*box.colors*box.sum movebox:=i ENDIF IF (((box.bluw*box.colors*box.sum)>bigbox)) bigbox:=box.bluw*box.colors*box.sum movebox:=i ENDIF CASE QUANT_MEDIANCUT7 IF (((box.redw*box.sum)>bigbox)) bigbox:=box.redw*box.colors*box.sum movebox:=i ENDIF IF (((box.grnw*box.sum)>bigbox)) bigbox:=box.grnw*box.colors*box.sum movebox:=i ENDIF IF (((box.bluw*box.sum)>bigbox)) bigbox:=box.bluw*box.colors*box.sum movebox:=i ENDIF ENDSELECT ENDIF ENDFOR swapboxes(bv,bv+(movebox*SIZEOF box)) /* FOR i:=0 TO boxes-1 box:=bv+(i*SIZEOF box) WriteF('\n#\d[3] (\d[4] s\d[4] c\d[4]) (\d[3],\d[3])\d[3] (\d[3],\d[3])\d[3] (\d[3],\d[3])\d[3]',i,box.ind,box.sum,box.colors,box.red0,box.red1,box.redw,box.grn0,box.grn1,box.grnw,box.blu0,box.blu1,box.bluw) ENDFOR */ ENDWHILE break3: FOR bi:=0 TO (boxes-1) box:=bv+(bi*SIZEOF box) indx:=box.ind clrs:=box.colors SELECT QUANT_END OF mode CASE QUANT_MEDIANCUT r:=0;g:=0;b:=0;sum:=0 FOR i:=0 TO (clrs-1) chi:=chv+((indx+i)*SIZEOF colorhist_item) colo:=chi.color r:=r+((PPM_GETR(colo))) g:=g+((PPM_GETG(colo))) b:=b+((PPM_GETB(colo))) sum:=sum+1 ENDFOR r:=limit(r/sum,0,255) g:=limit(g/sum,0,255) b:=limit(b/sum,0,255) CASE QUANT_MEDIANCUT2,QUANT_MEDIANCUT3 r:=SpFlt(0);g:=SpFlt(0);b:=SpFlt(0);sum:=SpFlt(0) FOR i:=0 TO (clrs-1) chi:=chv+((indx+i)*SIZEOF colorhist_item) colo:=chi.color tmp1:=SpFlt(chi.value) r:=SpAdd(r,SpMul(SpFlt(PPM_GETR(colo)),tmp1)) g:=SpAdd(g,SpMul(SpFlt(PPM_GETG(colo)),tmp1)) b:=SpAdd(b,SpMul(SpFlt(PPM_GETB(colo)),tmp1)) sum:=SpAdd(sum,tmp1) ENDFOR IF SpFix(sum)=0 THEN sum:=SpFlt(1) r:=limit(SpFix(SpDiv(sum,r)),0,255) g:=limit(SpFix(SpDiv(sum,g)),0,255) b:=limit(SpFix(SpDiv(sum,b)),0,255) DEFAULT r:=SpFlt(0);g:=SpFlt(0);b:=SpFlt(0) rsum:=SpFlt(0);gsum:=SpFlt(0);bsum:=SpFlt(0) FOR i:=0 TO (clrs-1) chi:=chv+((indx+i)*SIZEOF colorhist_item) colo:=chi.color tmp1:=SpFlt(chi.value) r:=SpAdd(r,SpMul(SpFlt(PPM_GETR(colo) OR 1),tmp1));rsum:=SpAdd(rsum,tmp1) g:=SpAdd(g,SpMul(SpFlt(PPM_GETG(colo)),tmp1));gsum:=SpAdd(gsum,tmp1) b:=SpAdd(b,SpMul(SpFlt(PPM_GETB(colo) OR 4),tmp1));bsum:=SpAdd(bsum,tmp1) -> IF mode=QUANT_MEDIANCUT2 IF PPM_GETR(colo)>63 AND PPM_GETR(colo)<196 r:=SpAdd(r,SpMul(SpFlt(PPM_GETR(colo) OR $1),tmp1));rsum:=SpAdd(rsum,tmp1) ENDIF IF PPM_GETG(colo)>63 AND PPM_GETG(colo)<196 g:=SpAdd(g,SpMul(SpFlt(PPM_GETG(colo)),tmp1));gsum:=SpAdd(gsum,tmp1) ENDIF IF PPM_GETB(colo)>63 AND PPM_GETB(colo)<196 b:=SpAdd(b,SpMul(SpFlt(PPM_GETB(colo) OR 4),tmp1));bsum:=SpAdd(bsum,tmp1) ENDIF -> ENDIF ENDFOR IF SpFix(rsum)=0 THEN rsum:=SpFlt(1) IF SpFix(gsum)=0 THEN gsum:=SpFlt(1) IF SpFix(bsum)=0 THEN bsum:=SpFlt(1) r:=limit(SpFix(SpDiv(rsum,r)),0,255) g:=limit(SpFix(SpDiv(gsum,g)),0,255) b:=limit(SpFix(SpDiv(bsum,b)),0,255) ENDSELECT chi:=colormap+(bi*SIZEOF colorhist_item) chi.color:=PPM_ASSIGN(r,g,b) ENDFOR ENDIF Dispose(bv) ENDIF ENDPROC colormap PROC swapboxes(box1:PTR TO box,box2:PTR TO box) DEF tmp tmp:=box1.ind; box1.ind:=box2.ind; box2.ind:=tmp tmp:=box1.colors; box1.colors:=box2.colors; box2.colors:=tmp tmp:=box1.sum; box1.sum:=box2.sum; box2.sum:=tmp tmp:=box1.redw; box1.redw:=box2.redw; box2.redw:=tmp tmp:=box1.grnw; box1.grnw:=box2.grnw; box2.grnw:=tmp tmp:=box1.bluw; box1.bluw:=box2.bluw; box2.bluw:=tmp tmp:=box1.red0; box1.red0:=box2.red0; box2.red0:=tmp tmp:=box1.grn0; box1.grn0:=box2.grn0; box2.grn0:=tmp tmp:=box1.blu0; box1.blu0:=box2.blu0; box2.blu0:=tmp tmp:=box1.red1; box1.red1:=box2.red1; box2.red1:=tmp tmp:=box1.grn1; box1.grn1:=box2.grn1; box2.grn1:=tmp tmp:=box1.blu1; box1.blu1:=box2.blu1; box2.blu1:=tmp ENDPROC PROC computecolorhist(redbuf,grnbuf,blubuf,cols,rows,maxcolors,colorsP) DEF cht=0 DEF chv=0 cht:=computecolorhash(redbuf,grnbuf,blubuf,cols,rows,maxcolors,colorsP) IF cht chv:=colorhashtocolorhist(cht,maxcolors) freecolorhash(cht) RETURN chv ELSE RETURN 0 ENDIF ENDPROC PROC computecolorhash(redbuf:PTR TO CHAR,grnbuf:PTR TO CHAR,blubuf:PTR TO CHAR,cols,rows,maxcolors,colorsP:PTR TO LONG) DEF cht=0:PTR TO LONG DEF pP=0 DEF chl=0:PTR TO colorhist_list_item DEF col,row,hash,ccoolloorr cht:=alloccolorhash() IF cht IF colorsP colorsP[0]:=0 row:=0 REPEAT IF checkcancel(statwindow) freecolorhash(cht) Raise("canc") ENDIF IF ((row/4)=((row+3)/4)) IF gaugeobj THEN fuelgauge(statwindow.rport,gaugeobj,row,rows-1,stat.histogram_string,drawinfo) ENDIF col:=0 REPEAT ccoolloorr:=(PPM_PUTR(redbuf[pP]) OR PPM_PUTG(grnbuf[pP]) OR PPM_PUTB(blubuf[pP]) AND $FCFEF8) -> Give RED 6 BITS, GRN 7 BITS, and BLU 5 BITS...this helps improve clustering, and to keep the number of unique colors below 32768 ! hash:=HASHPIXEL(ccoolloorr) chl:=cht[hash] WHILE (chl<>0) IF (chl.ch.color=ccoolloorr) JUMP break ENDIF chl:=chl.next ENDWHILE break: IF (chl<>0) chl.ch.value:=(chl.ch.value+1) ELSE colorsP[0]:=colorsP[0]+1 IF colorsP[0]>maxcolors freecolorhash(cht) RETURN 0 ENDIF -> chl:=New(SIZEOF colorhist_list_item) chl:=alloc(histopool,SIZEOF colorhist_list_item) IF chl chl.ch.color:=ccoolloorr chl.ch.value:=1 chl.next:=cht[hash] cht[hash]:=chl ENDIF ENDIF col:=col+1;pP:=pP+1;UNTIL col=cols row:=row+1;UNTIL row=rows ENDIF ENDIF ENDPROC cht PROC alloccolorhash() DEF cht=0 cht:=New((HASH_SIZE*4)+20) ENDPROC cht PROC colorhashtocolorhist(cht:PTR TO LONG,maxcolors) DEF chv=0:PTR TO colorhist_item DEF chl=0:PTR TO colorhist_list_item DEF i,j chv:=New((maxcolors*SIZEOF colorhist_item)+20) j:=0 FOR i:=0 TO (HASH_SIZE-1) chl:=cht[i] WHILE (chl<>0) PutLong(chv+(j*SIZEOF colorhist_item),chl.ch.color) PutLong(chv+4+(j*SIZEOF colorhist_item),chl.ch.value) j:=j+1 chl:=chl.next ENDWHILE ENDFOR ENDPROC chv PROC freecolorhash(cht) DEF i DEF chl:PTR TO colorhist_list_item DEF chlnext i:=0 deletepool(histopool) Dispose(cht) ENDPROC 0 PROC qsort(chv,l,r,and) DEF i,j,x,m1,m2 x:=((Long(chv+((Shr(l+r,1))*SIZEOF colorhist_item))) AND and) i:=l j:=r REPEAT WHILE (((Long(chv+(i++*SIZEOF colorhist_item))) AND and) < x) ENDWHILE WHILE (x<((Long(chv+(j*SIZEOF colorhist_item))) AND and)) j:=j-1 ENDWHILE IF (i-- <=j) m1:=chv+(j*SIZEOF colorhist_item) m2:=chv+(i*SIZEOF colorhist_item) MOVE.L m1,A0 MOVE.L m2,A1 MOVE.L (A0),D0 MOVE.L (A1),(A0)+ MOVE.L D0,(A1)+ MOVE.L (A0),D0 MOVE.L (A1),(A0) MOVE.L D0,(A1) i:=i+1 DEC j ENDIF UNTIL i>j IF l<j THEN qsort(chv,l,j,and) IF i<r THEN qsort(chv,i,r,and) ENDPROC PROC doexchange(cmap,pen,r,g,b,uhp) DEF newpen newpen:=findcolorbytes(cmap,r,g,b,uhp) exchangecolorcmap(cmap,pen,newpen) ENDPROC PROC sizebox(box:PTR TO box,chv) DEF i,ptr:PTR TO colorhist_item DEF mr=255,mg=255,mb=255,xr=0,xg=0,xb=0 DEF color,r,g,b ptr:=chv+(box.ind*SIZEOF colorhist_item) FOR i:=0 TO box.colors-1 color:=ptr.color MOVE.L color,D0 MOVE.L D0,D1 AND.L #$FF,D1 MOVE.L D1,b LSR.L #8,D0 MOVE.L D0,D1 AND.L #$FF,D1 MOVE.L D1,g LSR.L #8,D0 MOVE.L D0,D1 AND.L #$FF,D1 MOVE.L D1,r IF (r<mr) THEN mr:=r IF (g<mg) THEN mg:=g IF (b<mb) THEN mb:=b IF (r>xr) THEN xr:=r IF (g>xg) THEN xg:=g IF (b>xb) THEN xb:=b ptr:=ptr+SIZEOF colorhist_item ENDFOR box.redw:=xr-mr box.grnw:=xg-mg box.bluw:=xb-mb box.red0:=mr box.grn0:=mg box.blu0:=mb box.red1:=xr box.grn1:=xg box.blu1:=xb -> WriteF('\n (\d,\d ---\d) (\d,\d ---\d) (\d,\d ---\d)',box.red0,box.red1,box.redw,box.grn0,box.grn1,box.grnw,box.blu0,box.blu1,box.bluw) ENDPROC PROC mergesize(sizestruct:PTR TO sizestruct,pixw,pixh,redbuf:PTR TO CHAR,grnbuf:PTR TO CHAR,blubuf:PTR TO CHAR,bufw,bufh) DEF cursx,cursy DEF charptr,i,t,x,y,w=0,h=0,tw=0,th=0,ii,tt DEF sizestr[100]:STRING DEF str[10]:STRING DEF mergebuf:PTR TO CHAR,font:PTR TO CHAR,offx DEF br,bg,bb,p mergebuf:=New(8000) StringF(sizestr,'\dx\d',pixw,pixh) FOR i:=0 TO (StrLen(sizestr)-1) w,h:=getfontwh(sizestruct.font,sizestr[i]) tw:=tw+w th:=bigger(th,h) ENDFOR IF sizestruct.x=-1 THEN sizestruct.x:=(bufw/2)-(tw/2) IF sizestruct.y=-1 THEN sizestruct.y:=(bufh-th-2) offx:=1;tw:=tw+2;th:=th+2 FOR i:=0 TO (StrLen(sizestr)-1) w,h,font:=getfontwh(sizestruct.font,sizestr[i]) FOR tt:=0 TO (h-1) FOR ii:=0 TO (w-1) mergebuf[ii+offx+((tt+1)*tw)]:=font[ii+(tt*w)] ENDFOR ENDFOR offx:=offx+w ENDFOR FOR ii:=0 TO tw-1 FOR tt:=0 TO th-1 p:=sizestruct.x+ii+(tt*bufw)+(sizestruct.y*bufw) IF p>=0 IF (p<(bufw*bufh)) br:=redbuf[p] bg:=grnbuf[p] bb:=blubuf[p] i:=Char(mergebuf+ii+(tt*tw)) IF sizestruct.type=TEXT_SHADOW br:=limit(((br+i)/2),0,255) bg:=limit(((bg+i)/2),0,255) bb:=limit(((bb+i)/2),0,255) ELSE br:=i bg:=i bb:=i ENDIF redbuf[p]:=br grnbuf[p]:=bg blubuf[p]:=bb ENDIF ENDIF ENDFOR ENDFOR ENDPROC PROC getfontwh(font:PTR TO CHAR,chr) DEF fw,fh,i IF ((chr<"0") OR (chr>"9")) THEN chr:=("9"+1) IF chr>"0" FOR i:=0 TO ((chr-"0")-1) fw:=font[0];fh:=font[1] font:=(font+(fw*fh)+2) ENDFOR ENDIF fw:=font[0];fh:=font[1] font:=font+2 ENDPROC fw,fh,font PROC fuelgauge(rport,gaugeobj,level,top,string,drawinfo) SetAttrsA(gaugeobj, [IA_DATA,string, GAUGEIA_TOP,top, GAUGEIA_CURLEVEL,level, GAUGEIA_BOTTOM,0, TAG_END]) DrawImageState(rport,gaugeobj,0,0,IDS_NORMAL,drawinfo) ENDPROC